﻿<%
'''核心工具类
'使用该类需要启用Fso
Class ToolClass
	'使用核心类必须先实例化Fso
	
	'''备份的基准路径
	Private s_bckpath
	
	'构造
	Private Sub Class_Initialize()
		s_bckpath = "/" & C_DataFolder & "/backup/" & Year(Now()) & "/" & Month(Now()) & "/" & Day(Now())
	End Sub
	
	'析构
	Private Sub Class_Terminate()
	End Sub
	
	'''创建/更新.htaccess文件
	'载入App的rule.asp文件
	'0无rule
	'1成功
	'2创建失败
	'3备份失败
	Public Function BulidHtaccess()
		If Fso.IsFile("/" & C_AppFolder & "/" & C_ConfFolder & "/rule.asp") Then
			'rule.asp已经是加载了的
			'Asp.Include("/" & C_AppFolder & "/" & C_ConfFolder & "/rule.asp")
			Dim t_key, t_str
			t_str = "<IfModule mod_rewrite.c>" & vbcrlf &_
					"RewriteEngine on" & vbcrlf &_
					"RewriteCond %{REQUEST_FILENAME} !-d" & vbcrlf &_
					"RewriteCond %{REQUEST_FILENAME} !-f" & vbcrlf
			For Each t_key In G_Rule
				'注释
				t_str = t_str & "#" & G_Rule(t_key)(0) & vbcrlf
				'显示链接：实际指向链接
				t_str = t_str & "RewriteRule " & G_Rule(t_key)(3) & " " & G_Rule(t_key)(4) & vbcrlf
			Next
			t_str = t_str & "</IfModule>"
			'保存.htaccess旧文件
			If Fso.IsFile("/.htaccess") Then
				Dim t_res,t_to : t_to = s_bckpath & "/htaccess.txt"
				t_res = Fso.CopyFile("/.htaccess", t_to)
				If t_res Then
					Fso.CharSet = "GB2312"
					t_res = Fso.CreateFile("/.htaccess", t_str)
					If t_res Then
						BulidHtaccess = 1
					Else
						BulidHtaccess =2
					End If
					'''Fso编码未还原成UTF-8导致乱码
					Fso.CharSet = "UTF-8"
				Else
					BulidHtaccess = 3
				End If
			End If
		Else
			BulidHtaccess = 0
		End If
	End Function
	
	'''添加URL静态规则
	'使用本函数需先加载rule.asp
	'规则字典ID,原始链接符合规则、构建URL、获取链接符合规则、构建原始链接
	Public Function AddUrlRule(Byval p_id, Byval p_name, Byval p_ruleo, Byval p_urlo, Byval p_rulet, Byval p_urlt)
		If G_Rule.Exists(Clng(p_id)) Then
			'保持Rule的ID唯一
			AddUrlRule = 0
			Exit Function
		Else
			'先备份文件
			Dim t_from : t_from = "/" & C_AppFolder & "/Conf/rule.asp"
			Dim t_to : t_to = s_bckpath & "/rule.asp"
			Dim t_res : t_res = Fso.CopyFile(t_from, t_to)
			'是否已插入
			Dim t_hasin : t_hasin = False
			If t_res Then
				Dim t_str : t_str = "Dim G_Rule : Set G_Rule = Server.CreateObject(""" & C_DicName & """)" & vbcrlf
				For Each t_key In G_Rule
					'进行插入判断
					If Not t_hasin Then
						If t_key >= p_id Then
							t_str = t_str & "'" & p_name & vbcrlf
							t_str = t_str & "G_Rule(" & p_id & ") = Array("""& p_name &""","""& p_ruleo & """,""" & p_urlo & """,""" & p_rulet & """,""" & p_urlt & """)" & vbcrlf
							t_hasin = True
						End If
					End If
					t_str = t_str & "'" & G_Rule(t_key)(0) & vbcrlf
					t_str = t_str & "G_Rule(" & t_key & ") = Array("""& G_Rule(t_key)(0) &""","""& G_Rule(t_key)(1) & """,""" & G_Rule(t_key)(2) & """,""" & G_Rule(t_key)(3) & """,""" & G_Rule(t_key)(4) & """)" & vbcrlf
				Next
				'''如果没有在For循环插入则在最后插入
				If Not t_hasin Then
					t_str = t_str & "'" & p_name & vbcrlf
					t_str = t_str & "G_Rule(" & p_id & ") = Array("""& p_name &""","""& p_ruleo & """,""" & p_urlo & """,""" & p_rulet & """,""" & p_urlt & """)" & vbcrlf
				End If
				t_str = "<" & "%" & vbcrlf & t_str & "%" & ">"
				Dim t_res2 : t_res2 = Fso.CreateFile(t_from, t_str)
				If t_res2 Then
					'添加成功
					AddUrlRule = 1
				Else
					'创建文件失败
					AddUrlRule = 3
				End If
			Else
				'备份失败
				AddUrlRule = 2
			End If
		End If
	End Function
	
	'''修改URL静态规则
	'使用本函数需先加载rule.asp
	'规则字典ID,原始链接符合规则、构建URL、获取链接符合规则、构建原始链接
	Public Function EdtUrlRule(Byval p_oid, Byval p_id, Byval p_name, Byval p_ruleo, Byval p_urlo, Byval p_rulet, Byval p_urlt)
		If IsN(p_oid) Or IsN(p_id) Then
			EdtUrlRule = 0
			Exit Function
		End If
		If G_Rule.Exists(p_oid) Then
			'先备份文件
			Dim t_from : t_from = "/" & C_AppFolder & "/Conf/rule.asp"
			Dim t_to : t_to = s_bckpath & "/rule.asp"
			Dim t_res : t_res = Fso.CopyFile(t_from, t_to)
			If t_res Then
				Dim t_str : t_str = "Dim G_Rule : Set G_Rule = Server.CreateObject(""" & C_DicName & """)" & vbcrlf
				For Each t_key In G_Rule
					'进行插入判断
					If Cstr(t_key)=Cstr(p_oid) Then
						t_str = t_str & "'" & p_name & vbcrlf
						t_str = t_str & "G_Rule(" & p_id & ") = Array("""& p_name &""","""& p_ruleo & """,""" & p_urlo & """,""" & p_rulet & """,""" & p_urlt & """)" & vbcrlf
					Else
						t_str = t_str & "'" & G_Rule(t_key)(0) & vbcrlf
						t_str = t_str & "G_Rule(" & t_key & ") = Array("""& G_Rule(t_key)(0) &""","""& G_Rule(t_key)(1) & """,""" & G_Rule(t_key)(2) & """,""" & G_Rule(t_key)(3) & """,""" & G_Rule(t_key)(4) & """)" & vbcrlf
					End If
				Next
				t_str = "<" & "%" & vbcrlf & t_str & "%" & ">"
				Dim t_res2 : t_res2 = Fso.CreateFile(t_from, t_str)
				If t_res2 Then
					'修改成功
					EdtUrlRule = 1
				Else
					'创建文件失败
					EdtUrlRule = 3
				End If
			Else
				'备份失败
				EdtUrlRule = 2
			End If
		Else
			'未找到该Rule
			EdtUrlRule = 0
		End If
	End Function
	
	'''删除URL静态规则
	'使用本函数需先加载rule.asp
	'规则字典ID,原始链接符合规则、构建URL、获取链接符合规则、构建原始链接
	Public Function DelUrlRule(Byval p_id)
		If IsN(p_id) Then
			EdtUrlRule = 0
			Exit Function
		End If
		If G_Rule.Exists(p_id) Then
			'先备份文件
			Dim t_from : t_from = "/" & C_AppFolder & "/Conf/rule.asp"
			Dim t_to : t_to = s_bckpath & "/rule.asp"
			Dim t_res : t_res = Fso.CopyFile(t_from, t_to)
			If t_res Then
				Dim t_str : t_str = "Dim G_Rule : Set G_Rule = Server.CreateObject(""" & C_DicName & """)" & vbcrlf
				For Each t_key In G_Rule
					'非该ID则写入新文件
					If Cstr(t_key)<>Cstr(p_id) Then
						t_str = t_str & "'" & G_Rule(t_key)(0) & vbcrlf
						t_str = t_str & "G_Rule(" & t_key & ") = Array("""& G_Rule(t_key)(0) &""","""& G_Rule(t_key)(1) & """,""" & G_Rule(t_key)(2) & """,""" & G_Rule(t_key)(3) & """,""" & G_Rule(t_key)(4) & """)" & vbcrlf
					End If
				Next
				t_str = "<" & "%" & vbcrlf & t_str & "%" & ">"
				Dim t_res2 : t_res2 = Fso.CreateFile(t_from, t_str)
				If t_res2 Then
					'修改成功
					DelUrlRule = 1
				Else
					'创建文件失败
					DelUrlRule = 3
				End If
			Else
				'备份失败
				DelUrlRule = 2
			End If
		Else
			'未找到该Rule
			DelUrlRule = 0
		End If
	End Function
	
	'''创建/更新Action文件
	Public Function BuildAction(Byval p_aname)
	End Function
	
	'''创建/更新Extends文件
	Public Function BuildExtends(Byval p_ename)
	End Function
	
	'''创建/更新Lang文件
	Public Function BuildLang(Byval p_lang)
	End Function
	
	'''创建/更新Model
	Public Function BuildModel(Byval p_mname)
	End Function
	
	'''创建/更新System
	Public Function BuildSystem(Byval p_sname)
	End Function
	
	'''刷新Application
	Public Function RefreshApp()
		On Error Resume Next
		Sa.ClearApp()
		If Err.Number<>0 Then
			RefreshApp = 0
		Else
			RefreshApp = 1
		End If
		Err.Clear()
	End Function
	
	'''创建/更新HTML
	Public Function BuildHtml(Byval p_pname)
	End Function
	
	'''创建/更新入口文件(无敏感信息,不需备份)
	'入口文件如果失败,运行一次/ashapo/即可
	Public Function BuildEnter()
		Dim t_s : t_s = "<" & "%" & vbcrlf
		'先进行HTML静态页跳转
		t_s = t_s & "Dim i_u : i_u = Request.ServerVariables(""SCRIPT_NAME"") & ""?"" & Request.QueryString" & vbcrlf
		t_s = t_s & "Dim t_h : t_h = Application(""" & C_HtmlCacheAppKey & """)" & vbcrlf
		t_s = t_s & "If IsArray(t_h) Then" & vbcrlf
		t_s = t_s & "	If TypeName(t_h(0)) = ""Dictionary "" Then" & vbcrlf
		t_s = t_s & "		If t_h(0).Exists(i_u) Then" & vbcrlf
		t_s = t_s & "			Server.Transfer(t_h(0)(i_u))" & vbcrlf
		t_s = t_s & "		End If" & vbcrlf
		t_s = t_s & "	End If" & vbcrlf
		t_s = t_s & "End If" & vbcrlf
		t_s = t_s & "Dim i_g : i_g = Request.QueryString(""g"")" & vbcrlf
		t_s = t_s & "Dim i_m : i_m = Request.QueryString(""m"")" & vbcrlf
		t_s = t_s & "Dim i_a : i_a = Request.QueryString(""a"")" & vbcrlf
		t_s = t_s & "If i_g = """" Then i_g = """ & C_DefGroup & """ End If" & vbcrlf
		t_s = t_s & "If i_m = """" Then i_m = """ & C_DefModule & """ End If" & vbcrlf
		t_s = t_s & "If i_a = """" Then i_a = """ & C_DefAction & """ End If" & vbcrlf
		t_s = t_s & "Dim path : path = ""/" & C_DataFolder & "/_cache/_run/"" & i_g & ""/"" & i_m & ""_"" & i_a & "".asp""" & vbcrlf
		t_s = t_s & "Dim t_a : t_a = Application(""" & C_AspCacheAppKey & """)" & vbcrlf
		t_s = t_s & "If IsArray(t_a) Then" & vbcrlf
		t_s = t_s & "	If TypeName(t_a(0)) = ""Dictionary "" Then" & vbcrlf
		t_s = t_s & "		If t_a(0).Exists(path) Then" & vbcrlf
		t_s = t_s & "			Server.Transfer(path)" & vbcrlf
		t_s = t_s & "		Else" & vbcrlf
		t_s = t_s & "			Server.Transfer(""/" & C_CoreFolder & "/index.asp"")" & vbcrlf
		t_s = t_s & "		End If" & vbcrlf
		t_s = t_s & "	Else" & vbcrlf
		t_s = t_s & "		Server.Transfer(""/" & C_CoreFolder & "/index.asp"")" & vbcrlf
		t_s = t_s & "	End If" & vbcrlf
		t_s = t_s & "Else" & vbcrlf
		t_s = t_s & "	Server.Transfer(""/" & C_CoreFolder & "/index.asp"")" & vbcrlf
		t_s = t_s & "End If" & vbcrlf
		t_s = t_s & "%" & ">"
		If Fso.CreateFile("/index.asp", t_s) Then
			BuildEnter = 1
		Else
			BuildEnter = 0
		End If
	End Function
	
	'''删除运行缓存
	'0失败
	'1成功
	Public Function ClearCache()
		If Fso.DelFolder("/"&C_DataFolder&"/"&C_CacheFolder&"/*") Then
			ClearCache = 1
		Else
			ClearCache = 0
		End If
	End Function
End Class
%>